home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / feel0_89.lha / Feel / Boot / class-defs.em < prev    next >
Encoding:
Text File  |  1993-07-15  |  10.1 KB  |  401 lines
  1. ;; Eulisp Module
  2. ;; Author: pab
  3. ;; File: <class>defs.em
  4. ;; Date: Mon Oct  5 13:20:58 1992
  5. ;;
  6. ;; Project:
  7. ;; Description: 
  8. ;;
  9.  
  10. (defmodule class-defs
  11.   (   
  12.    class-macs
  13.    )
  14.   ()
  15.   (reset-classes)
  16.  
  17.   (define-prim-class <object> ()
  18.     ()
  19.     )
  20.  
  21.   (define-prim-class <class> (<object>)
  22.     ((instance-size position 0
  23.             accessor class-instance-size)
  24.      (name position 1 
  25.        accessor class-name)
  26.      (super-classes position 2
  27.             accessor class-direct-superclasses)
  28.      (subclasses position 3
  29.          accessor class-direct-subclasses)
  30.      ;; actually slot-table...
  31.      (local-slot-descriptions position 4
  32.                accessor class-local-slot-descriptions)
  33.      (slot-descriptions position 5
  34.         accessor class-slot-descriptions)
  35.      (non-local-descriptions position 6
  36.            accessor class-non-local-slot-descriptions)
  37.      (precedence position 7
  38.          accessor class-precedence-list)
  39.      (initargs  position 8
  40.         accessor class-initargs)
  41.      (spare position 9
  42.         accessor class-spare))
  43.     direct-initargs (direct-superclasses direct-slot-descriptions direct-initargs name)
  44.     constructor make-class
  45.     metaclass <class>)
  46.   
  47.   
  48.   ;; Telos classes:
  49.   (define-prim-class <instantiable-class> (<class>)
  50.     ()
  51.     allocate t)
  52.  
  53.   (define-prim-class <si-class> (<instantiable-class>)
  54.     ()
  55.     allocate t)
  56.   
  57.   (define-prim-class <abstract-class> (<class>)
  58.     ()
  59.     metaclass <class>
  60.     allocate t)
  61.  
  62.   (define-prim-class <structure-class> (<si-class>)
  63.     ()
  64.     metaclass <class>
  65.     allocate t)
  66.  
  67.   (define-prim-class <mi-class> (<instantiable-class>)
  68.     ()
  69.     allocate t)
  70.  
  71.   (define-prim-class <slot-description-class> (<class>)
  72.     ()
  73.     metaclass <class>
  74.     allocate t)
  75.  
  76.   (define-prim-class <structure> (<object>)
  77.     ()
  78.     metaclass <structure-class>
  79.     allocate t)
  80.      
  81.   ;; from slots.h
  82.   (define-prim-class <slot-description> (<object>)
  83.     ((name position 0
  84.        accessor slot-description-name
  85.        initarg name)
  86.      (position position 1
  87.            initarg position
  88.            accessor slot-description-position)
  89.      ;; ack!
  90.      (initarg position 2
  91.           initarg initarg
  92.           ;;initform unbound-slot-value
  93.           accessor slot-description-initarg)
  94.      (initfunction position 3
  95.            initarg initfunction
  96.            ;;initform unbound-slot-value
  97.            accessor slot-description-initfunction)
  98.      (slot-writer position 4
  99.           initarg writer
  100.           accessor slot-description-slot-writer)
  101.      (slot-reader position 5
  102.           initarg reader
  103.           accessor slot-description-slot-reader))
  104.     direct-initargs (name position initfunction reader writer initarg)
  105.     constructor make-slot-description
  106.     metaclass <slot-description-class>
  107.     allocate t)
  108.  
  109.   ;; should never be instatiated by new protocol
  110.   (define-prim-class <local-slot-description> (<slot-description>)
  111.     ()
  112.     allocate t)
  113.   
  114.   (define-prim-class <unreadable-slot-description> (<local-slot-description>)
  115.     ()
  116.     allocate t
  117.     metaclass <slot-description-class>)
  118.  
  119.   ;; function meta-hierarchy
  120.  
  121.   (define-prim-class <funcallable-object-class> (<class>)
  122.     ()
  123.     metaclass <class>)
  124.  
  125.   (define-prim-class <generic-class> (<funcallable-object-class>)
  126.     ()
  127.     metaclass <class>)
  128.  
  129.    (define-prim-class <bytefunction-class> (<funcallable-object-class>)
  130.      ()
  131.      metaclass <class>)
  132.  
  133.   (define-prim-class <funcallable-object> (<object>)
  134.     ()
  135.     metaclass <funcallable-object-class>
  136.     allocate t
  137.     )
  138.  
  139.   (define-prim-class <function> (<funcallable-object>)
  140.      ;; usually a lisp <object>, but can be NULL!
  141.     ((argtype position 0 class <unreadable-slot-description>)
  142.      (env position 1 class <unreadable-slot-description>)
  143.      (xxx position 2 class <unreadable-slot-description>)
  144.      (name position 3 accessor function-name)
  145.      (home position 4 accessor function-home))
  146.     metaclass <funcallable-object-class>)
  147.   
  148.   (define-prim-class <i-function> (<function>)
  149.     ((body position 5 accessor i-function-body))
  150.     metaclass <funcallable-object-class>)
  151.  
  152.   (define-prim-class <c-function> (<function>)
  153.     ()
  154.     metaclass <funcallable-object-class>)
  155.  
  156.   ;;(compile-time 
  157.   (define-prim-class <bytefunction> (<funcallable-object>)
  158.     ((env position 0
  159.       accessor bytefunction-env)
  160.      (offset position 1
  161.          reader bytefunction-offset)
  162.      (nargs position 2
  163.         reader bytefunction-nargs)
  164.      (globals position 3
  165.           reader bytefunction-globals)
  166.      (setter position 4
  167.          reader bytefunction-setter))
  168.     metaclass <bytefunction-class>)
  169.  
  170.   (define-prim-class <extended-bytefunction> (<bytefunction>)
  171.     ((info position 5 accessor extended-bytefunction-info))
  172.     metaclass <bytefunction-class>)
  173.    ;;)
  174.  
  175.  
  176.   ;; from generics.h
  177.   ;; OK. The standard version
  178.   (define-prim-class <generic-function> (<funcallable-object>)
  179.     ((name position 0
  180.        accessor generic-name
  181.        initarg name)
  182.      (discriminator position 1
  183.        accessor generic-discriminator)
  184.      (argtype position 2
  185.           initarg argtype
  186.           accessor generic-argtype)
  187.      (fast-cache position 3
  188.          accessor generic-fast-cache)
  189.      (slow-cache position 4
  190.          accessor generic-slow-cache)
  191.      (method-table position 5
  192.            accessor generic-method-table)
  193.      ;; actually, this is a hack so that I can do generic-range.
  194.      ;; contains range and method-class
  195.      (method-description position 6
  196.            accessor generic-method-description)
  197.      ;; used to be discriminator...
  198.      (method-lookup-function position 7
  199.             accessor generic-method-lookup-function)
  200.      (discrimination-depth position 8
  201.                accessor generic-discrimination-depth)
  202.      (setter position 9
  203.          accessor generic-setter))
  204.     direct-initargs (method-class methods domain)
  205.     metaclass <generic-class>)
  206.   
  207.  
  208.   (define-prim-class <method-class> (<class>)
  209.     ()
  210.     metaclass <class>)
  211.   
  212.   (define-prim-class <method> (<object>)
  213.     ((method-qualifier position 0
  214.                accessor method-qualifier)
  215.      (signature position 1
  216.         accessor method-signature)
  217.      (generic-function position 2
  218.        initform ()
  219.        accessor method-generic-function)
  220.      (function position 3
  221.            initarg function
  222.            accessor method-function)
  223.      (fixed position 4
  224.         accessor method-fixed))
  225.     direct-initargs (domain range function signature)
  226.     metaclass <method-class>)
  227.  
  228.   (define-prim-class <condition-class> (<class>)
  229.     ()
  230.     metaclass <class>)
  231.  
  232.   ;; from error.h
  233.   
  234.   (define-prim-class <condition> (<object>)
  235.     ((message position 0
  236.           initarg message
  237.           accessor condition-message)
  238.      (error-value initarg error-value 
  239.           position 1 
  240.           accessor condition-error-value))
  241.     direct-initargs (message error-value)
  242.     metaclass <condition-class>)
  243.  
  244.   (define-prim-class <Internal-Error> (<condition>)
  245.     ()
  246.     metaclass <condition-class>)
  247.   
  248.   (define-prim-class <clock-tick> (<condition>)
  249.     ()
  250.     metaclass <condition-class>)
  251.  
  252.   (define-prim-class <invalid-operator> (<condition>)
  253.     ((args position 2 initarg args accessor invalid-operator-args)
  254.      (op position 3 initarg op accessor invalid-operator-op))
  255.     allocate t
  256.     metaclass <condition-class>)
  257.  
  258.   ;; threads and the like
  259.   
  260.   (define-prim-class <thread-class> (<class>)
  261.     ()
  262.     metaclass <class>)
  263.  
  264.   (define-prim-class <thread> (<object>)
  265.     ((data position 0 )
  266.      (state position 1  accessor thread-internal-state)
  267.      (fun position 2 class <unreadable-slot-description>)
  268.      (args position 3 accessor thread-args)
  269.      (value position 4 )
  270.      (cochain position 5 class <unreadable-slot-description> accessor thread-cochain)
  271.      (signal-list position 6 accessor thread-signals))
  272.     metaclass <thread-class>)
  273.  
  274.   ;; primitive classes 
  275.  
  276.   (define-prim-class <primitive-class> (<class>)
  277.     ()
  278.     metaclass <class>)
  279.  
  280.   (define-prim-class <character> (<object>)
  281.     ()
  282.     metaclass <primitive-class>)
  283.  
  284.   
  285.   (define-prim-class <symbol> (<object>)
  286.     ()
  287.     metaclass <primitive-class>)
  288.  
  289.  
  290.   (define-prim-class <weak-wrapper> (<object>)
  291.     ()
  292.     metaclass <primitive-class>)
  293.  
  294.   (define-prim-class <continuation> (<funcallable-object>)
  295.     ()
  296.     metaclass <primitive-class>)
  297.  
  298.   (with-sockets
  299.    (define-prim-class <socket> (<object>)
  300.      ()
  301.      metaclass <primitive-class>)
  302.  
  303.    (define-prim-class <listener> (<object>)
  304.      ()
  305.      metaclass <primitive-class>)
  306.    )
  307.  
  308.   ;; Collections
  309.   (define-prim-class <collection> (<object>)
  310.     ()
  311.     allocate t
  312.     metaclass <abstract-class>
  313.     )
  314.  
  315.   (define-prim-class <table> (<collection>)
  316.     ((table-values position 0 accessor table-values)
  317.      (table-population position 1 initform 0 accessor table-population)
  318.      (table-threshold position 2 initform 14 accessor table-threshold)
  319.      (table-filled position 3 accessor table-filled)
  320.      (table-comparator position 4 initarg comparator initform () accessor table-comparator)
  321.      (table-hash-function position 5 initarg hash-function initform () accessor table-hash-function)
  322.      (table-fill position 6 initarg fill initform () accessor table-fill))
  323.     metaclass <class>
  324.     )
  325.  
  326.   ;; and sequences..
  327.   (define-prim-class <sequence> (<collection>)
  328.     ()
  329.     metaclass <abstract-class>
  330.     allocate t
  331.     )
  332.   
  333.   (define-prim-class <string> (<sequence>)
  334.     ()
  335.     metaclass <primitive-class>)
  336.  
  337.   ;; Could be variable-sized-class, but we don't have
  338.   ;; a use for that yet...
  339.  
  340.   (define-prim-class <vector-class> (<primitive-class>)
  341.     ()
  342.     metaclass <class>
  343.     allocate t)
  344.  
  345.   (define-prim-class <vector> (<sequence>)
  346.     ()
  347.     metaclass <vector-class>)
  348.  
  349.   ;; number hierarchy...
  350.   
  351.   (define-prim-class <number-class> (<primitive-class>)
  352.     ()
  353.     metaclass <class>
  354.     allocate t)
  355.  
  356.   (define-prim-class <number> (<object>)
  357.     ()
  358.     metaclass <number-class>)
  359.  
  360.   (define-prim-class <float> (<number>)
  361.     ()
  362.     allocate t
  363.     )
  364.  
  365.   (define-prim-class <double-float> (<float>)
  366.     ()
  367.     metaclass <number-class>)
  368.  
  369.   (define-prim-class <integer> (<number>)
  370.     ()
  371.     allocate t
  372.     metaclass <number-class>)
  373.  
  374.   (define-prim-class <fixint> (<integer>)
  375.     ()
  376.     metaclass <number-class>)
  377.   
  378.   ;; lists --- the other way...
  379.  
  380.   (define-prim-class <list> (<sequence>)
  381.     ()
  382.     metaclass <abstract-class>
  383.     allocate t)
  384.   
  385.   (define-prim-class <pair> (<list>)
  386.     ()
  387.     metaclass <primitive-class>)
  388.   
  389.   (define-prim-class <null> (<list>)
  390.     ()
  391.     metaclass <primitive-class>)
  392.  
  393.   (define-prim-class <special-method> (<object>)
  394.     ((id initarg id position 0 accessor sm-id))
  395.     direct-initargs (id)
  396.     allocate t)
  397.  
  398.  
  399.   ;; end module
  400.   )
  401.